﻿// Binding.fs
//
// Copyright 2009 Sergey Mechtaev
//
// This program is free software; you can redistribute it and/or
// modify it under the terms of the GNU General Public License
// as published by the Free Software Foundation.


#light

namespace SmartCPP.Core.Preprocessor

open SmartCPP.Core.Parser.Lexer

module Binding =

    
    ///Represents a text with its generation history
    ///Changed of length*base*segment*new
    ///Substring of base*segment
    ///File of length*name*content
    ///String of length*content
    type Text = 
        | Changed of int*Text*Segment*Text
        | Substring of Text*Segment
        | File of int*string*char[]
        | String of int*string
        
        
    ///Calculate text length
    let textLength text = 
        match text with
            | Changed (length, _, _, _) -> length
            | Substring (_, (start, length)) -> length
            | File (length, _, _) -> length
            | String (length, _) -> length
     
    ///Shift serment on offset       
    let addOffset seg offset = 
        (fst seg + offset, snd seg)
        
    ///Get preimage of segment
    ///result is (source, position, string) list, where source is file name or ""
    let rec preimage seg history =
        match history with
            | File (length, name, content) -> let sub = Array.sub content (fst seg) (snd seg) in [(name, seg, new System.String(sub))]
            | String (length, content) -> [("", seg, content.Substring(fst seg, snd seg))]
            | Substring (text, segment) -> preimage (fst seg + fst segment, snd seg) text
            | Changed (length, original, segment, newtext) ->
                (*
                printfn "original="
                printf "%A" original
                printfn ""  
                printfn "newtext="
                printf "%A" newtext
                printfn ""
                printfn "segment="
                printf "%A" segment
                printfn ""
                printfn "need="
                printf "%A" seg
                printfn ""
                *)
                let seg_start = fst seg
                let seg_length = snd seg
                let newtext_length = textLength newtext
                let newtext_start = fst segment
                let oldtext_length = snd segment
                
                ///Get intersection of two sements or (0,0) if it is empty
                let intersection (x1, y1) (x2, y2) =
                    let left = max x1 x2
                    let right = min y1 y2
                    if left < right then (left, right) else (0, 0)
                    
                let left_segment = 
                    if newtext_start > seg_start 
                    then (seg_start, if newtext_start>seg_start+seg_length then seg_length else newtext_start-seg_start)
                    else (0, 0)
                let right_segment = 
                    if seg_start+seg_length > newtext_start+newtext_length 
                    then 
                        let start = (max (newtext_start+newtext_length) seg_start)
                        (start + oldtext_length - newtext_length, (min length seg_start+seg_length) - start)
                    else (0, 0)                
                let center_segment =
                    let intrsct = intersection (seg_start, seg_start+seg_length) (newtext_start, newtext_start+newtext_length)
                    (fst intrsct-newtext_start , snd intrsct - fst intrsct)
                (*    
                printfn "left_segment="
                printf "%A" left_segment
                printfn ""
                printfn "center_segment="
                printf "%A" center_segment
                printfn ""
                printfn "right_segment="
                printf "%A" right_segment
                printfn ""
                *)
                (if snd left_segment > 0 then preimage left_segment original else [])
                @
                (if snd center_segment > 0 then preimage center_segment newtext else [])
                @
                (if snd right_segment > 0 then preimage right_segment original else [])

    ///Convert segment coordinates (absolute offset from 0 and length) 
    ///to line and column coordinates (numeration from 1)
    ///Parameter lines is list of lines lingths      
    let segToLineAndColumn lines seg =
        let x1 = fst seg
        let x2 = fst seg + snd seg 
        let rec find lines line offset =
            match lines with
                | [] -> (line, 1)
                | h::t ->
                    if h > offset 
                    then (line, offset+1)
                    else find t (line+1) (offset-h)
        (find lines 1 x1, find lines 1 x2)

    ///Convert line and column coordinates (numeration from 1) 
    ///to segment coordinates (absolute offset from 0 and length)
    ///Parameter lines is list of lines lingths
    let lineAndColumnToSeg lines ((l1, c1), (l2, c2)) =
        let rec find lines l c offset =
            match lines with
                | [] -> offset
                | h::t ->
                    if l>1
                    then find t (l-1) c (offset+h)
                    else offset + c - 1
        let x1 = find lines l1 c1 0
        let x2 = find lines l2 c2 0
        (x1, x2-x1)